home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
QRZ! Ham Radio 8
/
QRZ Ham Radio Callsign Database - Volume 8.iso
/
mac
/
german
/
tcpip
/
gp160.exe
/
#GPRI.EXE
/
TTT.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1993-09-13
|
10KB
|
373 lines
{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V+,X-}
{$M 1024,0,0}
PROGRAM TicTacToe;
{ Tic Tac Toe für GP }
USES Dos,GPRI; { Units DOS und GPRI einbinden }
CONST
MaxHelp = 16; { Anzahl der Helptext-Zeilen }
Wa : Char = '-'; { ASCII-Zeichen für waagerechten Strich }
Se : Char = '!'; { ASCII-Zeichen für senkrechten Strich }
Kr : Char = '+'; { ASCII-Zeichen für Kreuz }
TYPE
PosiType = ARRAY[0..2,0..2] OF Byte;
VAR
N : Byte;
StrPtr : String;
Position : PosiType;
HilfsText : ARRAY[1..MaxHelp] OF String[80];
Spiel,
Gewinner : Byte;
Zahl : String[5];
FUNCTION GrossSchrift (S : String) : String;
{ Wandelt einen Sting in Großbuchstaben um }
VAR
L : Byte;
BEGIN
FOR L := 1 TO Length(S) DO S[L] := UpCase(S[L]);
GrossSchrift := S;
END;
PROCEDURE Strategie;
{ Spielstrategie je nach Position der Steine auf dem Spielfeld }
VAR
X,Y,
N,M : Byte;
Bool : Boolean;
BEGIN
X := 255;
Y := 255;
Bool := FALSE;
FOR N := 0 TO 2 DO BEGIN
IF NOT Bool AND (Position[N,0] = 0) AND (Position[N,1] > 0)
AND (Position[N,2] = Position[N,1]) THEN BEGIN
X := N;
Y := 0;
Bool := Position[N,1] = 2;
END;
IF NOT Bool AND (Position[0,N] = 0) AND (Position[1,N] > 0)
AND (Position[2,N] = Position[1,N]) THEN BEGIN
X := 0;
Y := N;
Bool := Position[1,N] = 2;
END;
IF NOT Bool AND (Position[N,2] = 0) AND (Position[N,0] > 0)
AND (Position[N,0] = Position[N,1]) THEN BEGIN
X := N;
Y := 2;
Bool := Position[N,0] = 2;
END;
IF NOT Bool AND (Position[2,N] = 0) AND (Position[0,N] > 0)
AND (Position[0,N] = Position[1,N]) THEN BEGIN
X := 2;
Y := N;
Bool := Position[0,N] = 2;
END;
IF NOT Bool AND (Position[N,1] = 0) AND (Position[N,0] > 0)
AND (Position[N,0] = Position[N,2]) THEN BEGIN
X := N;
Y := 1;
Bool := Position[N,0] = 2;
END;
IF NOT Bool AND (Position[1,N] = 0) AND (Position[0,N] > 0)
AND (Position[0,N] = Position[2,N]) THEN BEGIN
X := 1;
Y := N;
Bool := Position[0,N] = 2;
END;
END;
IF NOT Bool AND (Position[1,1] = 0) AND ((Position[0,0] > 0)
AND (Position[0,0] = Position[2,2])
OR (Position[2,0] > 0)
AND (Position[2,0] = Position[0,2])) THEN BEGIN
X := 1;
Y := 1;
Bool := Position[0,0] = 2;
END;
IF Position[1,1] > 0 THEN BEGIN
IF NOT Bool AND (Position[0,0] = 0)
AND (Position[1,1] = Position[2,2]) THEN BEGIN
X := 0;
Y := 0;
Bool := Position[1,1] = 2;
END;
IF NOT Bool AND (Position[2,2] = 0)
AND (Position[1,1] = Position[0,0]) THEN BEGIN
X := 2;
Y := 2;
Bool := Position[1,1] = 2;
END;
IF NOT Bool AND (Position[0,2] = 0)
AND (Position[1,1] = Position[2,0]) THEN BEGIN
X := 0;
Y := 2;
Bool := Position[1,1] = 2;
END;
IF NOT Bool AND (Position[2,0] = 0)
AND (Position[1,1] = Position[0,2]) THEN BEGIN
X := 2;
Y := 0;
Bool := Position[1,1] = 2;
END;
END;
IF (X = 255) THEN
REPEAT
X := Random(3);
Y := Random(3);
UNTIL Position[X,Y] = 0;
Position[X,Y] := 2;
END;
PROCEDURE ResetSpielFeld;
{ Alle Steine vom Spielfeld räumen }
VAR
X,Y : Byte;
BEGIN
FOR Y := 0 TO 2 DO
FOR X := 0 TO 2 DO
Position[X,Y] := 0;
END;
FUNCTION Sieger : Byte;
{ Ermittelt den Gewinner der Patie. }
{ Ausgabe: 0 = Spiel noch nicht zuende }
{ 1 = Spieler hat gewonnen }
{ 2 = Computer hat gewonnen }
{ 3 = Unentschieden }
VAR
N,S : Byte;
BEGIN
S := 0;
N := 0;
WHILE (S = 0) AND (N < 3) DO BEGIN
IF (Position[N,0] = Position[N,1]) AND (Position[N,0] = Position[N,2]) THEN
S := Position[N,0];
Inc(N);
END;
N := 0;
WHILE (S = 0) AND (N < 3) DO BEGIN
IF (Position[0,N] = Position[1,N]) AND (Position[0,N] = Position[2,N]) THEN
S := Position[0,N];
Inc(N);
END;
IF S = 0 THEN
IF (Position[0,0] = Position[1,1]) AND (Position[0,0] = Position[2,2]) THEN
S := Position[0,0];
IF S = 0 THEN
IF (Position[0,2] = Position[1,1]) AND (Position[0,2] = Position[2,0]) THEN
S := Position[0,2];
IF S = 0 THEN BEGIN
N := 0;
WHILE (N < 8) AND (Position[N MOD 3,N DIV 3] > 0) DO
Inc(N);
IF N = 8 THEN S := 3;
END;
Sieger := S;
END;
FUNCTION SpielFeld : String;
{ "Zeichnet" das Spielfeld }
VAR
S : String;
X,Y : Byte;
BEGIN
S := ' A B C '#13+
' '+Se+' '+Se+' 1'#13+
' '+Wa+Wa+Wa+Kr+Wa+Wa+Wa+Kr+Wa+Wa+Wa+' '#13+
' '+Se+' '+Se+' 2'#13+
' '+Wa+Wa+Wa+Kr+Wa+Wa+Wa+Kr+Wa+Wa+Wa+' '#13+
' '+Se+' '+Se+' 3'#13;
FOR Y := 0 TO 2 DO
FOR X := 0 TO 2 DO BEGIN
IF Position[X,Y] = 1 THEN S[(X*4+7)+(Y*36+18)] := 'X';
IF Position[X,Y] = 2 THEN S[(X*4+7)+(Y*36+18)] := 'O';
END;
Gewinner := Sieger;
IF Gewinner > 0 THEN BEGIN
S := S+#13;
IF Gewinner = 1 THEN S := S+'Gratuliere, Sie haben gewonnen.';
IF Gewinner = 2 THEN S := S+'Sie haben leider verloren.';
IF Gewinner = 3 THEN S := S+'Unentschieden.';
S := S+#13;
S := S+'Ein weiteres Spiel ? (J/N) > ';
Spiel := 1;
END ELSE
S := S+'> ';
SpielFeld := #13+S;
END;
FUNCTION Parser (S : String) : Boolean;
VAR
X,Y : Byte;
BEGIN
IF (S[1] >= 'A') AND (S[1] <= 'C') AND
(S[2] > '0') AND (S[2] < '4') THEN BEGIN
X := Ord(S[1])-65;
Y := Ord(S[2])-49;
IF Position[X,Y] = 0 THEN BEGIN
Position[X,Y] := 1;
Parser := TRUE;
END ELSE
Parser := FALSE;
END ELSE
Parser := FALSE;
END;
{$F+}
{ Von hier an werden die Routinen FAR compiliert }
PROCEDURE RX (S : String);
BEGIN
ProgrammEnde := FALSE;
N := Pos('> ',S);
IF N > 0 THEN Delete(S,1,N+1);
IF S[1] > #96 THEN Dec(Byte(S[1]),32);
CASE Spiel OF
0: BEGIN { normaler Spielmodus }
IF Parser(S) THEN BEGIN
IF Sieger = 0 THEN Strategie;
StrPtr := SpielFeld;
END ELSE BEGIN
IF Upcase(S[1]) = 'E' THEN BEGIN
ProgrammEnde := TRUE;
StrPtr := #13'Spiel abgebrochen.'#13;
END ELSE BEGIN
IF Upcase(S[1]) = 'I' THEN BEGIN
Se := '│';
Wa := '─';
Kr := '┼';
StrPtr := 'IBM-Zeichensatz aktiviert.'#13+SpielFeld;
END ELSE BEGIN
IF S[1] = '?' THEN BEGIN
FOR N := 1 TO MaxHelp DO
SendString(HilfsText[N]);
StrPtr := SpielFeld;
END ELSE BEGIN
StrPtr := 'Ungueltiges Feld oder Feld schon besetzt.'#13'> ';
END;
END;
END;
END;
END;
1: BEGIN { Antwort auf Frage nach neuem Spiel auswerten }
IF (S[1] = 'J') OR (S[1] = 'Y') THEN BEGIN
ResetSpielFeld;
Randomize;
IF Gewinner = 1 THEN Strategie;
Gewinner := 0;
StrPtr := SpielFeld;
Spiel := 0;
END ELSE BEGIN
ProgrammEnde := TRUE; { GP auffordern, das Programm zu beenden }
StrPtr := '73 und bis bald mal wieder...'#13;
END;
END;
END;
SendString(StrPtr); { Datenstring aussenden }
END;
PROCEDURE Intro;
VAR
I : Byte;
S1,S2 : String[2];
BEGIN
IF ParamCount > 0 THEN { Kommandozeile nach Wort "IBM" durchsuchen }
FOR I := 1 TO ParamCount DO
IF GrossSchrift(ParamStr(I)) = 'IBM' THEN BEGIN
{ Wenn gefunden, IBM-Grafikzeichen verwenden }
Se := '│';
Wa := '─';
Kr := '┼';
END;
Randomize;
Gewinner := 0;
Spiel := 0;
ResetSpielFeld;
Str(GPRI_VersionHi:2,S1);
Str(GPRI_VersionLo,S2);
IF GPRI_VersionLo < 10 THEN S2 := '0'+S2;
StrPtr := '**** Tic Tac Toe for GP ****'#13+
'*** (C) Ulf Saran DH1DAE ***'#13+
'**** GPRI Version '+S1+'.'+S2+' ****'#13+
'("?" = Hilfe';
IF Se <> '│' THEN
StrPtr := StrPtr+' "IBM" = IBM-Zeichensatz)'+#13#13
ELSE
StrPtr := StrPtr+')'#13#13;
SendString(StrPtr); { Datenstring aussenden }
StrPtr := SpielFeld; { Datenstring mit Spielfeld laden }
SendString(StrPtr); { Datenstring aussenden }
END;
VAR
Num : Word;
Task : TaskType;
BEGIN
IF NOT TaskInit(@Intro,@RX,NIL,NIL) THEN BEGIN
Writeln('Dieses Programm kann nur als GP Remote-Programm gestartet werden.');
Halt;
END;
Hilfstext[1] := 'Kurzbeschreibung von Tic Tac Toe fuer GP:'#13#13;
HilfsText[2] := 'Sinn des Spiels ist es, drei eigene Spielsteine entweder'#13;
HilfsText[3] := 'horizontal, vertikal oder diagonal nebeneinander anzuordnen.'#13;
HilfsText[4] := 'Ihre Spielsteine werden dabei durch ein X gekennzeichnet,'#13;
HilfsText[5] := 'die des Computers durch ein O.'#13;
HilfsText[6] := 'Die Spielfelder werden durch eine Kombination aus je einem'#13;
HilfsText[7] := 'Buchstaben und einer Ziffer gekennzeichnet. Das linke obere'#13;
HilfsText[8] := 'Feld ist die Position A1, das rechte untere Feld C3'#13#13;
HilfsText[9] := 'Die Eingabe der Positionsangaben erfolgt interaktiv, d.h.'#13;
HilfsText[10] := 'Sie brauchen nur die Eingabeaufforderung abzuwarten und dann'#13;
HilfsText[11] := 'einfach die gewünschten Koordinaten einzugeben.'#13#13;
HilfsText[12] := 'Am Ende eines Spiels koennen sie ein neues Spiel starten.'#13;
HilfsText[13] := 'Entscheiden Sie sich fuer ein neues Spiel, dann beginnt'#13;
HilfsText[14] := 'derjenige, der das letzte Spiel verloren hat. Bei einem'#13;
HilfsText[15] := 'Unentschieden fangen Sie an.'#13;
HilfsText[16] := 'Die Eingabe von EXIT beendet das Spiel vorzeitig.'#13;
Keep(0); { Programm speicherresident installieren }
END.